COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C  MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
C00015 ENDMK
C⊗;
C  MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
C *** READS DATA FROM DSK FOR VARIOUS THINGS.

	COMMON /DL/IXRX,SAVER,NAME,EXT /FRMT/F78F(1),FA1(1),FA5(1),ASK
	1 /LIMIT/LIMIT,ITEM,L,I,M /DPY/GO,TOP,BOT /FONT/JFONT
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
C					   ↓↓↓↓↓ V IS FOR READIN ONLY
C%%%%%%%%
	COMMON /STF/RSTFAC(0/7),RSTJ2 /POSI/STFF(0/7),JJ2,POS
	1 /PTR/PWDS(300)
	1/PLTR/PLT,RHT,DIS,XDIS
	COMMON /XRN/ RN(3000),V(2000) /ALF/INP(72),ML /SSS/SSS(200)
	1 /SLR/SLURX(272) 
C ORDER OF COMMON MUST! REMAIN AS IS (FOR DMP MODE READ)
	DATA DIS/1.24/
	CALL SEGFIX
C  TO ENABLE MULTIPLE USE OF UPPER SEGMENT (TVR)
	CALL MPRFAI
	END    

C***** SOME TYPEOUT AND ACCEPT ROUTINES *******

CC	SUBROUTINE WHY      
CC	END

	SUBROUTINE UNKNWN(JA)
	TYPE 5700,JA
5700	FORMAT(' UNKNOWN CODE=',I3)
C TRAP FOR UNKNOWN CODE #S (SUCH AS 99 - FOR "NO KSIG".
	END

	SUBROUTINE ENDIT(A,ITMS)
	COMMON /OUTF/JJ,KOUT
	TYPE 300,A,ITMS,KOUT
	CALL PLOT(0,0,99)
C  THE END OF THE DATA
300	FORMAT(F7.2,' INCHES',I,' ITEMS ',9X,A5,'.PLT')
C  THE END OF THE DATA
	END

	SUBROUTINE ILLEGL(JA)
	TYPE 160,JA
160	FORMAT(' ILLEGAL STAFF# ',I4)
	END

	SUBROUTINE TOOMCH(K)
	TYPE 4202,K
	STOP
4202	FORMAT(' ***** TOO MUCH DATA ',I6,'/2500')
	END

CCCCCCCCCCCCCCCCCCC  SUBRS.  SLUR, PLTSRT, (LINES, RDRAW),PLTCMD

	SUBROUTINE PLTCMD(NOSET)
	COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK /OUTF/JJ,KOUT
	DIMENSION NMS(15),RMOV1(15),RMOV2(15)
	COMMON /DL/RSIZ,SAVER,NAME,EXT /ALF/INP(72),ML
	COMMON R2,JE,CENTR,JB,RJQ(20),JQ(20)
	EQUIVALENCE (R5,RJQ(3)),(R6,RJQ(4)),(R7,RJQ(5)),(R4,RJQ(2))
	1,(R3,RJQ(1)),(I2,INP(2)),(R8,RJQ(6)),(R9,RJQ(7))
C  BE CAREFUL OF COMMON OVERLAPS WITH NOTWRT,ITMSUB,HOMER, ETC.
CC	F78F(1)='(78F)'
CC	FA5(1)='(A5) '
	DATA FA1(1)/'(A1) '/,F78F(1)/'(78F)'/,EXT/'DMD'/

	IF(I2.NE.'%')GO TO 1
CC	IF(I2.NE.'X')GO TO 1
	I2=0
C  I2=% FIRST TIME THROUGH  (WAS X, BEFORE 2/78)
	RXC=0
	RMOV1(1)='Y'
	NAME=0
14	KA=0
3	KA=KA+1
	IF(MLL.EQ.0)GO TO 15
	K=K-2
	MLL=MLL-1
	IF(MLL.NE.0)GO TO 31
	IF(MORE)GO TO 10
C ADD 100 TO RSPC TO READ IN NEW ALPHABETICAL SERIES OF FILES.
CC	IF(MLL.EQ.0)GO TO 10
CC	GO TO 31
15	TYPE 2,KA
CF	ACCEPT 11,K,MLL,RSPC
C  TYPE FIRST NAME, NUMBER  FOR A SERIES, 2ND NUM FOR FIXED SPACE ".
	CALL NAMEXT(K,EXT,MLL,RSPC)
CF	REREAD 351,JJ,R8 
	MORE=-1
	IF(RSPC.LT.100)GO TO 30
	MORE=0
	RSPC=RSPC-100.
30	IF(K.NE.' ')GO TO 51
	IF(KA.NE.1)GO TO 10
C  DEFAULT NAME IS 'TMP    1'
	K='TMP'
	MLL=1
51	IF(K.EQ.'99')GO TO 140
C  99=BACKUP
	IF(JJ.NE.'EXT ')GO TO 251
C TYPE 'EXT XXX' TO READ FILES WITH EXTENSION .XXX
	EXT=R8
	GO TO 15
351	FORMAT(A4,A3)
251	IF(MLL.GE.99)GO TO 151
	IF(MLL.EQ.0)GO TO 151
	K=K+2*(MLL-1)
C THIS CHANGES GIVEN NAME TO LAST OF SERIES.
C I.E. AAAAA 5  WILL GET AAAAE FIRST AND WORK BACKWARDS.
151	IF(K.NE.'NOSET')GO TO 31
	NOSET=-1
C  ACTIVATES ANTI-RESET IN MPRFAI.FAI
	GO TO 15

31	IF(LOOKX(K,EXT))GO TO 56
C JUMP IF FILE FOUND
	TYPE 55
	GO TO 15
55	FORMAT(' FILE NOT FOUND'/)
11	FORMAT(A5,I,F)
56	IF(MLL.LT.99)GO TO 560
	MLL=0 
561	K=K+2
C  TYPE 'AAAAA 99'  TO FIND ALL IN 'AAAAx' SERIES AUTOMATICALLY
	MLL=MLL+1
	IF(LOOKX(K,EXT))GO TO 561
C  KEEPS GOING BACK IF FILES ARE FOUND
	K=K-2
560	NMS(KA)=K
	IF(MLL.EQ.0)GO TO 5
	R8='Y'
	IF(RSPC.NE.0)R8=RSPC
	GO TO 21
5	TYPE 8
	ACCEPT 11,R8
	IF(R8.EQ.'99')GO TO 15
	IF(R8.NE.'Y')R8=0
	IF(R8.EQ.0)REREAD F78F,R8
C  MOVE NUMBER CAN BE TYPED FOR 'MOVE UP'
21	RMOV1(KA+1)=R8
	RMOV2(KA)=R8
	GO TO 3
140	KA=KA-1
	GO TO 15

10	KB=KA-1
	IF(I3.NE.'G')GO TO 22
	RSIZ=1
	GO TO 222
22	TYPE 9
	ACCEPT F78F,RSIZ,R9
C  SET R9 TO 1 FOR HEAVY STAFF LINES (FOR XGP MAINLY)
	IF(RSIZ.EQ.99)GO TO 5
	IF(RSIZ.EQ.0)RSIZ=1.
	TYPE 550
	ACCEPT 11,JJ
	IF(JJ.EQ.' ')JJ='PLT'
	KOUT=JJ
550	FORMAT(' TYPE OUTPUT NAME - '$)
222	KA=0

1	IF(NAME.NE.0)GO TO 12
	IF(KA.NE.KB)GO TO 13
	I2=-1
	RETURN
C  THE END OF THE DATA
13	NAME=NMS(KA+1)
	TYPE 111,NAME,EXT
	RETURN
12	KA=KA+1
	NAME=0
	R8=0
	R2=RSIZ
	R3=RSIZ
C  FOR FILLER.  SIZES .LT. 1.6 = EVERY SCAN LINE, .LT. 2.6 = 2, ETC.
	R7=0
	R5=1
	R6=1
	IF(RMOV2(KA).NE.'Y')R7=RMOV2(KA)
	IF(RMOV1(KA).NE.0)R5=0
	IF(RMOV2(KA).NE.0)GO TO 77
	IF(R7.EQ.0)RETURN
77	R6=0
2	FORMAT(' TYPE FILE NAME',I2,1X$)
8	FORMAT(' MOVE UP AT END? ',$)
9	FORMAT(' SIZE FACTOR? ',$)
111	FORMAT(1XA5,'.',A3/)
	END


	SUBROUTINE SLUR
	IMPLICIT INTEGER(A-Q,T-Z)
	COMMON /ALF/INP,SLURY(72) /SSS/ SSS(200) /SLR/ SLURX(272) 
	REAL CENTR
	COMMON /PLTR/PLT,RHT,RDIS,XDIS
	COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,R7,R8,R9,R10,RA,RB,
	1 K,KQ,TWICE,RST7,RX,RXX,RTILT,RC,RZ,RW,J3,J4,
	1 J5,J6,J7,J8,J9,J10,J11,JQ(7),R,RJ
	1 /PTR/PWDS(1) /LIMIT/LIMIT,ITEM,L,I,IX /STF/RSTFAC(0/7),RSTJ2
CF	DATA RZZ/2.8/
C  DEFAULT VALUE OF SLUR CURVE FACTOR IS 2.8

2	J10=1
	J4=0
	KQ=5 
	TWICE=-1
C  -1 FOR DISPLAY, USES ONLY 1/3 OF SEGMENTS
	IF(PLT.GE.0)GO TO 21
	TWICE=0
	KQ=1
	RWID=.2
	IF(RHT.LT.2)GO TO 21
	TWICE=1
	RWID=.14
C  IF SIZE IS GT.2 3 SLURS ARE DRAWN
	IF(RHT.LT.3)GO TO 21
	TWICE=2
C  IF SIZE IS GE.3 4 SLURS ARE DRAWN
	RWID=.1
21	RST7=RSTJ2*7.
	RQQ=R5-R4
	IF(R6.GT.1000)CALL RNOTE(R6)
	GO TO (5,6,7),J8+4
	GO TO 4
5	R=30
CC5	R=32
C AFTER DOTTED NOTE
	GO TO 8
CC6	R=18
6	R=22
C BETWEEN NOTES
8	RX=-0.75
CC8	RX=-1.3
	GO TO 9
7	R=7
	RX=RSTJ2
9	CALL RJBX(R)
	R6=R6+RX
4	RXX=RHORZ(R6)-R3
	RTILT=RQQ*RST7
80	RX=SQRT(RXX*RXX+RTILT*RTILT)
	IF(J8.NE.-1)GO TO 10
	IF(RQQ.GT.8)RQQ=8
	IF(RQQ.LT.-8)RQQ=-8
CCCC	RQQ=RQQ*RSTFAC(J2)
	IF(R7)RQQ=-RQQ
	R3=R3-RQQ*RSTJ2
CCCC	R3=R3-RQQ
C  MOVES STEEP SLUR LEFT OR RIGHT IF P8=-1
10	RJ=ABS(R7)
C R7+100=LEFT HALF SLUR, +200=RIGHT HALF, +300=REVERSE DIRECTION.
	IF(RJ.LT.100)RJ=-1
	IF(RJ.GE.300)RJ=0
	R7=AMOD(R7,100.0)
	L=RDIS*RX/5
	IF(L.LT.15)L=15
	IF(L.GT.68)L=68
	L=L*4
C  L=NUMB OF SEGMENTS IN THE CURVE.
1	R=CENTR
	IF(J8.GT.0)GO TO 180
C  JUMP FOR BRACKETS
	CALL SLOOP

	IF(J4.NE.0)GO TO 83
87	CALL LINES(SLURX(J10),SLURY(J10),3)
	J4=-1
83	J5=KQ
	J6=J10
	J7=L
	IF(J4)GO TO 22
	J6=L
	J7=J10
	J5=-1
22	DO 88 K=J6,J7,J5
88	CALL LINES(SLURX(K),SLURY(K),2)
	IF(TWICE)RETURN
	TWICE=TWICE-1
	IF(J8.GT.0)GO TO 182
	J4=-J4
	R7=R7+RWID
C  RWID=WIDTH OF SLUR -- SEE DATA
	GO TO 1
180	RW=R+R7*RST7
	TWICE=-1
	KQ=1
	RX=RX+R3
CC	RA=(R5-R4)*RST7
	IF(J9.EQ.0)GO TO 181
	TWICE=2
	RZ=RTILT/(RX-R3)
	RXX=RX
	RWID=(R3+RXX)/2.
182	IF(TWICE.EQ.1)GO TO 183
C  DOES LEFT SIDE FIRST.
	IF(TWICE.EQ.0)GO TO 184
C LAST IS NUMBER.
	J8=2
	RC=RSTJ2*13.
	RX=RWID-RC
	RWW=RTILT
185	RTILT=RZ*(RX-R3)

C  PUT IN FUNC. HERE FOR THIS SLOPE AND FOR PART. BEAMS.

	GO TO 181
183	J8=3
	RX=RXX
	RTILT=RWW
	RXX=R3
	R3=RWID+RC
	RXX=RZ*(R3-RXX)
	R=R+RXX
	RW=RW+RXX
	GO TO 185

181	SLURX(1)=R3
	SLURY(1)=R
	SLURX(2)=R3
	SLURY(2)=RW
	SLURX(3)=RX
	SLURY(3)=RW+RTILT
	SLURX(4)=RX
	SLURY(4)=R+RTILT
	L=4
	IF(J8.EQ.2)L=3
	IF(J8.EQ.3)J10=2
CC	TWICE=-1
	GO TO 87
184	J3=RWID
C  PUT IN VERT. POS. WHEN SLOPE!
	R4=RQQ/2.+R4+R7-1.
	R6=0.875
C .875 IS SIZE OF NUM.   R7=1 MAKES ITALIC FONT
	R7=1.
	R8=0
	CALL MAKNUM(R9)
	END
C  8, POS1, STF, NT1, NT2, POS2, DIP(ABS. UNITS), P8
C        FOR P8: 0= SLUR, 1=BRACKETS, 2=LFT ONLY, 3=RT ONLY

	SUBROUTINE NAMEXT(NAME,EXT,NUM,SPC)
	COMMON /ALF/INP(72)
	DIMENSION FORM2(5),FORMT(5),NUMS(30)
	DATA FORMT(1)/'('/,FORM2/'A1,','A2,','A3,','A4,','A5,'/
	1, FORM3/'I,F)'/
	EQUIVALENCE (F1,FORMT(1)),(F2,FORMT(2)),(F3,FORMT(3)),
	1 (F4,FORMT(4)),(F5,FORMT(5))
1	FORMAT(72A1)
	ACCEPT 1,INP
	DO 2 K=2,72
	IF(INP(K).EQ.' ')GO TO 3
2	IF(INP(K).EQ.'.')GO TO 4
3	F3=FORM3
	F4=' '
	F5=' '
5	F2=FORM2(K-1)
	REREAD FORMT,NAME,NUM,SPC
	RETURN
4	FORMT(3)=FORM2(1)
C  CATCHES DOT
	DO 7 N=K+1,72
7	IF(INP(N).EQ.' ')GO TO 8
8	F4=FORM2(N-K-1)
	F5=FORM3
	F2=FORM2(K-1)
	REREAD FORMT,NAME,K,EXT,NUM,SPC
	END